BMUG PD-ROM 1995 Fall/PD-ROM F95.toast/Utilities/Text Utils/Alpha 5.81 ƒ/Tcl/SystemCode/c.tcl

Text File | 1994-07-07 | 5.0 KB | 210 lines | [TEXT/ALFA]

#=============================================================================
# "Electric" C functions.
#=============================================================================

# returns the indent string of the line named by 'pos'
proc indentString pos {
    set start [lineStart $pos]
    set end [nextLineStart $pos]
    set text [getText $start $end]
    for {set i 0} {1} {incr i} {
        set c [string index $text $i]
        if {($c != "\ ") && ($c != "\t")} then {
            return [string range $text 0 [expr $i-1]]
        }
    }
    return
}


# Brace on new line, same indentation. Insert on another new line, indented in.
# First, see if we are on new line.
proc electricCLeft {} {
    global elecLBrace
    deleteText [getPos] [selEnd]
    if {$elecLBrace == "0"} then {
        insertText "\{"
        return
    }
    set pos [getPos]
    set start [lineStart $pos]
    set text [getText $start $pos]

    for {set i $start} {$i < $pos} {incr i} {
        set c [lookAt $i]
        if {($c != "\ ") && ($c != "\t")} then {
            set indentation [getText $start $i]
            insertText " \{\r" $indentation "\t"
            return
        }
    }
    set indentation [getText $start $pos]
    insertText "\{\r" $indentation "\t"
}
bind '\{' <s> electricCLeft


# Brace on new line, immediate carriage return
proc electricCRight {} {
    global elecRBrace
    deleteText [getPos] [selEnd]
    if {$elecRBrace == "0"} then {
        insertText "\}"
        catch {blink [matchIt "\}" [expr [getPos]-2]]}
        return
    }
    set pos [getPos]
    set start [lineStart $pos]

    if {[catch {matchIt "\}" [expr $pos-1]} matched]} {
        beep
        return
    }
    set text [getText [lineStart $matched] $matched]
    regexp {^[     ]*} $text indentation
    for {set i $start} {$i < $pos} {incr i} {
        set c [lookAt $i]
        if {($c != "\ ") && ($c != "\t")} then {
            insertText "\r" $indentation "\}\r" $indentation
            blink $matched
            return
        }
    }
    set text [set indentation]\}\r$indentation
    replaceText $start $pos $text
    goto [expr {$start + [string length $text]}]
    blink [matchIt "\}" [expr $start-2]]
}
bind '\}' <s> electricCRight


# Brace on new line, immediate carriage return. We don't do our electric stuff
# if we are in the middle of a for statement.
proc electricCSemi {} {
    global electricSemi
    deleteText [getPos] [selEnd]
    if {$electricSemi == "0"} then {
        insertText ";"
        return
    }
    set pos [getPos]
    set start [lineStart $pos]
    set text [getText $start $pos]

    if {[string first "for" $text] != "-1"} {
        set lefts 0
        set rights 0
        set len [string length $text]
        for {set i 0} {$i < $len} {incr i} {
            case [string index $text $i] in {
                "("    { incr lefts }
                ")"    { incr rights }
            }
        }
        global globs
        set globs [list $lefts $rights $len]
        if {$lefts != $rights} {
            insertText ";"
            return
        }
    }

    insertText ";\r" [indentString $pos]
}
bind '\;' electricCSemi


# 'C' programming mode

proc setCMode {} {
    global thinkMenu
    changeMode "C"
    uplevel #0 {
        set prefixString "//"
        set elecLBrace 1
        set elecRBrace 1
        set electricSemi 1
        set wordWrap 0
        set funcExpr {^[^ \t\(#\r/@].*\(.*\)$}
        set sortedIsDefault 1
#        set wordBreakPreface {[^a-zA-Z0-9]}
#        set wordBreak {[a-zA-Z0-9]+}
        set wordBreakPreface {[^a-zA-Z0-9_]}
        set wordBreak {[a-zA-Z0-9_]+}
    }
    insertMenu    $thinkMenu
}

proc cMarkFile {} {
    global markSorting
    set markSorting 2
    set pos 0
    while {![catch {search -f 1 -r 1 -m 0 -i 0 {^([^ \t\(#\r/@].*[ \t]+)?([A-Za-z0-9:~_]+)[ \t\r]*\(.*\)[ \t]*$} $pos} res]} {
        set start [lindex $res 0]
        set end [expr [lindex $res 1] + 1]
        if {[regexp {([a-zA-Z:_]+)[ \t]*\(} [getText $start $end] dummy word]} {
            set inds($word) [lineStart [expr $start - 1]]
        }
        set pos $end
    }
    if {[info exists inds]} {
        foreach f [lsort [array names inds]] {
            set next [nextLineStart $inds($f)]
            setNamedMark $f $inds($f) $next $next
        }
    }
}

proc c++MarkFile {} {
    global mpos

    set end [maxPos]
    set pos 0
    set l {}
    while {![catch {search -f 1 -r 1 -m 0 -i 0 {^([^ \t\(#\r/@].*[ \t]+)?([A-Za-z0-9:~_]+)[ \t\r]*\(.*\)?$} $pos} res]} {
        set start [lindex $res 0]
        set end [nextLineStart $start]
        set word [lindex [getText $start $end] 0]
        lappend l $word
        set mpos($word) $start
        set pos $end
    }
    return [lsort $l]
}

proc setC++Mode {} {
    global wordBreakPreface wordBreak thinkMenu
    changeMode "C++"
     uplevel #0 {
        set prefixString "//"
        set elecLBrace 1
        set elecRBrace 1
        set electricSemi 1
        set wordWrap 0
          set funcExpr {^([^ \t\(#\r/@].*[ \t]+)?([A-Za-z0-9:~_]+)[ \t\r]*\(.*\)?$}
        set funcPar 2
        set sortedIsDefault 1
        set wordBreakPreface {[^a-zA-Z0-9_]}
        set wordBreak {[a-zA-Z0-9_]+}
    }
    insertMenu    $thinkMenu
}



source "$HOME:Tcl:SystemCode:think.tcl"


#================================================================================
# "C" code
#================================================================================
set cCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
set cPreRegexp        {^\#[\t ]*[a-z]*}
set cKeyWords        {void register short enum extern int for if while struct static long switch case char unsigned double float return else}

regModeKeywords -e {//} -b {/*} {*/} -c red -k blue C $cKeyWords
regModeKeywords -e {//} -b {/*} {*/} -c red -k blue {C++} [concat {new delete} $cKeyWords]